home *** CD-ROM | disk | FTP | other *** search
- /************************************************************************
- * *
- * The SB-Prolog System *
- * Copyright SUNY at Stony Brook, 1986; University of Arizona, 1987 *
- * *
- ************************************************************************/
-
- /*-----------------------------------------------------------------
- SB-Prolog is distributed in the hope that it will be useful,
- but WITHOUT ANY WARRANTY. No author or distributor
- accepts responsibility to anyone for the consequences of using it
- or for whether it serves any particular purpose or works at all,
- unless he says so in writing. Refer to the SB-Prolog General Public
- License for full details.
-
- Everyone is granted permission to copy, modify and redistribute
- SB-Prolog, but only under the conditions described in the
- SB-Prolog General Public License. A copy of this license is
- supposed to have been given to you along with SB-Prolog so you
- can know your rights and responsibilities. It should be in a
- file named COPYING. Among other things, the copyright notice
- and this notice must be preserved on all copies.
- ------------------------------------------------------------------ */
-
- /* meta.c */
-
- #include "builtin.h"
-
- extern double floatval();
- extern word makefloat();
-
- b_VAR()
- {
- register word op;
- register pw top;
-
- op = gregc(1);
- deref(op);
- if (isnonvar(op)) {Fail0;}
- }
-
- b_NONVAR()
- {
- register word op;
- register pw top;
-
- op = gregc(1);
- deref(op);
- if (!isnonvar(op)) {Fail0;}
- }
-
- b_ATOM()
- {
- register word op;
- register pw top;
-
- op = gregc(1);
- deref(op);
- if (!isatom(op)) {Fail0;}
- }
-
- b_ATOMIC()
- {
- register word op;
- register pw top;
-
- op = gregc(1);
- deref(op);
- if (!(isnum(op) || isatom(op))) {Fail0;}
- }
-
- b_INTEGER()
- {
- register word op;
- register pw top;
-
- op = gregc(1);
- deref(op);
- if (!isinteger(op)) {Fail0;}
- }
-
- b_REAL()
- {
- register word op;
- register pw top;
-
- op = gregc(1);
- deref(op);
- if (!isfloat(op)) {Fail0;}
- }
-
- b_STRUCTURE()
- {
- register word op;
- register pw top;
-
- op = gregc(1);
- deref(op);
- if (!(islist(op) || (isconstr(op) && (get_str_arity(op)!=0)))) {Fail0;}
- }
-
- b_TERMREP() /* r1 is term (var); r2 is integer that is its rep */
- {
- register word op;
- register pw top;
-
- op = gregc(1);
- deref(op);
- if (!unify(makeint(op), gregc(2))) {Fail0;}
- }
-
- b_DBREF()
- {
- register word op;
- register pw top;
- struct psc_rec *psc_ptr;
-
- op = gregc(1); deref(op);
- if ((op&TAGMASK) == CS_TAG) {
- psc_ptr = get_str_psc(op);
- if (get_etype(psc_ptr) != T_BUFF) {Fail0;}
- }
- else {Fail0;}
- }
-
- b_FLOOR0() /* F, I, N */
- {
- /* N is bound to a number which gives the direction of conversion:
- if N = 0 then F is bound to a real and I is a variable, while if
- N = 1 then F is a variable and I is bound to an integer. No
- checking for the above is done. */
-
- register word op1, op2, op3;
- register pw top;
-
- op1 = gregc(1); deref(op1);
- op2 = gregc(2); deref(op2);
- op3 = gregc(3); deref(op3);
- if (intval(op3)==0) { /* F=float, I=free */
- follow(op2) = makeint((word)((int)(floatval(op1))));
- pushtrail(op2);
- }
- else { /* F=free, I=integer */
- follow(op1) = makefloat((double)(intval(op2)));
- pushtrail(op1);
- };
- }
-
-